Pascal Super Library/Pascal Super Library (CW International)(1997).bin/BORL_TIP/TI100/TI673.ASC

Text File | 1992-08-12 | 5KB | 265 lines

  PRODUCT  :  Turbo Pascal                           NUMBER  :  673
  VERSION  :  6.0
       OS  :  MS/PC DOS
     DATE  :  August 12, 1992                          PAGE  :  1/4

    TITLE  :  Runtime Menubar and Statusline Change




  {

  This program changes menus at runtime as well as changing
  the statusline.  This program demonstrates how to change the
  statusline and the active commands linked to the statusline
  options.

  }

  {$X+}
  program ExampleProgram;

  uses
    Drivers, Objects, Views, App, Menus, Puzzle, Calendar;
  const
    PuzzleCmd   = 100;
    CalendarCmd = 101;
    SwitchCmd   = 102;

  var
    StatusLine1: PStatusLine;

  type
    TTestMain = object(TApplication)
      OtherMenu: PMenuBar;
      constructor Init;
      procedure Calendar;
      procedure HandleEvent(var Event: TEvent); virtual;
      procedure InitMenuBar; virtual;
      procedure InitStatusLine; virtual;
      procedure Puzzle;
      procedure SwitchMenu;
    end;

  { TTestMain }
  constructor TTestMain.Init;
  begin
    TApplication.Init;
  end;

  procedure TTestMain.Calendar;
  var
    CalendarWindow: PCalendarWindow;













  PRODUCT  :  Turbo Pascal                           NUMBER  :  673
  VERSION  :  6.0
       OS  :  MS/PC DOS
     DATE  :  August 12, 1992                          PAGE  :  2/4

    TITLE  :  Runtime Menubar and Statusline Change




  begin
    CalendarWindow := new(PCalendarWindow, Init);
    DeskTop^.Insert(CalendarWindow);
  end;

  procedure TTestMain.HandleEvent(var Event: TEvent);
  begin
    TApplication.HandleEvent(Event);
    if Event.What = evCommand Then
    begin
      case Event.Command of
        PuzzleCmd   : Puzzle;
        CalendarCmd : Calendar;
        SwitchCmd   : SwitchMenu;
      else
        Exit;
      end;
      ClearEvent(Event);
    end;
  end;

  Procedure TTestMain.InitMenuBar;
  var
    R: TRect;
  begin
    GetExtent(R);
    R.B.Y := R.A.Y+1;
    MenuBar := New(PMenuBar, Init(R, NewMenu(
       NewItem('~S~witch Menus','', 0, SwitchCmd, hcNoContext,
       NewSubMenu('~E~xample',hcNoContext,NewMenu(
       NewItem('~P~uzzle','', 0, PuzzleCmd, hcNoContext,
       NewItem('~C~alendar','', 0, CalendarCmd, hcNoContext,
       NewLine(
       NewItem('~Q~uit', '',0, cmQuit,
  hcNoContext,Nil))))),Nil)))));
    OtherMenu := New(PMenuBar, Init(R, NewMenu(
       NewItem('~S~witch Menus','', 0, SwitchCmd, hcNoContext,
       NewSubMenu('~O~ther Menu',hcNoContext,NewMenu(
       NewItem('~B~y', '', 0, cmQuit, hcNoContext,
       NewLine(
       NewItem('~Q~uit', '',0, cmQuit,
  hcNoContext,Nil)))),Nil)))));
  end;













  PRODUCT  :  Turbo Pascal                           NUMBER  :  673
  VERSION  :  6.0
       OS  :  MS/PC DOS
     DATE  :  August 12, 1992                          PAGE  :  3/4

    TITLE  :  Runtime Menubar and Statusline Change




  procedure TTestmain.InitStatusLine;
  var R: TRect;
  begin
    GetExtent(R);
    R.A.Y := R.B.Y - 1;
    StatusLine := New(PStatusLine, Init(R,
      NewStatusDef(0, $FFFF,
        NewStatusKey('', kbF10, cmMenu,
        NewStatusKey('~Alt-X~ Exit', kbAltX, cmQuit,
        nil)),
      nil)
    ));
    StatusLine1 := New(PStatusLine, Init(R,
      NewStatusDef(0, $FFFF,
        NewStatusKey('', kbF10, cmMenu,
        NewStatusKey('~P~uzzle', kbAltP, PuzzleCmd,
        nil)),
      nil)
    ));
  end;


  procedure TTestMain.Puzzle;
  var
   PuzzleWindow: PPuzzleWindow;
  begin
    PuzzleWindow := new(PPuzzleWindow, Init);
    DeskTop^.Insert(PuzzleWindow);
  end;

  procedure TTestMain.SwitchMenu;
  var
    Temp: PMenuBar;
    Temp1: PStatusLine;
  begin
    Delete(MenuBar);
    Temp := PMenuBar(MenuBar);
    MenuBar := OtherMenu;
    OtherMenu := Temp;
    Insert(MenuBar);
    Delete(StatusLine);
    Temp1 := PStatusLine(StatusLine);
    StatusLine := StatusLine1;













  PRODUCT  :  Turbo Pascal                           NUMBER  :  673
  VERSION  :  6.0
       OS  :  MS/PC DOS
     DATE  :  August 12, 1992                          PAGE  :  4/4

    TITLE  :  Runtime Menubar and Statusline Change




    StatusLine1 := Temp1;
    Insert(StatusLine);
    MenuBar^.DrawView;
    StatusLine^.DrawView;
  end;

  var
    Main: TTestMain;

  begin
    Main.Init;
    Main.Run;
    Main.Done;
  end.

  DISCLAIMER: You have the right to use this technical information
  subject to the terms of the No-Nonsense License Statement that
  you received with the Borland product to which this information
  pertains.